home *** CD-ROM | disk | FTP | other *** search
/ CD Actual 3 / CD ACTUAL 3.iso / linux / incoming / jstools-.6v3 / jstools- / jstools-tk3.6v3.0 / lib / jparseargs.tcl < prev    next >
Encoding:
Text File  |  1995-02-09  |  2.4 KB  |  67 lines
  1. # jparseargs.tcl - parse procedure options in -name value style
  2. # 
  3. # Copyright 1992-1994 by Jay Sekora.  All rights reserved, except 
  4. # that this file may be freely redistributed in whole or in part 
  5. # for non¡profit, noncommercial use.
  6. ######################################################################
  7.  
  8. ### TO DO
  9. ###   j:parse_args -boolean (and maybe -position?)
  10.  
  11. ######################################################################
  12. # j:parse_args arglist - parse arglist in parent procedure
  13. #   arglist is a list of option names (without leading "-");
  14. # this proc puts their values (if any) into variables (named after
  15. #   the option name) in d parent procedure
  16. # any element of arglist can also be a list consisting of an option
  17. #   name and a default value.
  18. ######################################################################
  19.  
  20. proc j:parse_args { arglist } {
  21.   upvar args args
  22.   
  23.   foreach pair $arglist {
  24.     set option [lindex $pair 0]
  25.     set default [lindex $pair 1]        ;# will be null if not supplied
  26.     set index [lsearch -exact $args "-$option"]
  27.     if {$index != -1} {
  28.       set index1 [expr {$index + 1}]
  29.       set value [lindex $args $index1]
  30.       uplevel 1 [list set $option $value]    ;# caller's variable "$option"
  31.       set args [lreplace $args $index $index1]
  32.     } else {
  33.       uplevel 1 [list set $option $default]    ;# caller's variable "$option"
  34.     }
  35.   }
  36.   return 0
  37. }
  38.  
  39. ######################################################################
  40. # j:parse_argv arglist - parse application's argv (and update argc)
  41. #   arglist is a list of option names (without leading "-");
  42. # this proc puts their values (if any) into variables (named after
  43. #   the option name) in the parent procedure
  44. # any element of arglist can also be a list consisting of an option
  45. #   name and a default value.
  46. ######################################################################
  47.  
  48. proc j:parse_argv { arglist } {
  49.   global argv argc
  50.   
  51.   foreach pair $arglist {
  52.     set option [lindex $pair 0]
  53.     set default [lindex $pair 1]        ;# will be null if not supplied
  54.     set index [lsearch -exact $argv "-$option"]
  55.     if {$index != -1} {
  56.       set index1 [expr {$index + 1}]
  57.       set value [lindex $argv $index1]
  58.       uplevel 1 [list set $option $value]    ;# caller's variable "$option"
  59.       set argv [lreplace $argv $index $index1]
  60.     } else {
  61.       uplevel 1 [list set $option $default]    ;# caller's variable "$option"
  62.     }
  63.   }
  64.   set argc [llength $argv]
  65.   return 0
  66. }
  67.